Also see core-practices-over-time.html.
dat <- import(here("data/longitudinal", "full-tags-wide.csv"))
dictionary <- import(here("data/2024 data", "dictionary_2024.csv"))
source(here("scripts/branding.R"))core_prac <- dat %>%
select(school_id, year, starts_with("core")) %>%
mutate(school_id = as.factor(school_id),
year = as.factor(year))
core_prac[is.na(core_prac)] <- 0
core_prac <- core_prac %>%
# summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
pivot_longer(starts_with("core"),
names_to = "core_practice",
values_to = "times_selected")
core_prac_dat <- core_prac %>%
group_by(core_practice) %>%
summarise(selected = sum(times_selected)) %>%
arrange(-selected)First note: there are 26 practices that have never been selected as a core practice. They are the following:
no_core <- core_prac_dat %>%
filter(selected == 0) %>%
mutate(core_practice = sub("core_", "", core_practice)) %>%
pull(core_practice)
no_core## [1] "data_instruction" "design_margins"
## [3] "devices_home" "ell_supports"
## [5] "equity_plan" "experiential"
## [7] "flexible_schedule" "graduation_supports"
## [9] "hiring_practices" "immigrants_supports"
## [11] "information_formats" "learner_agency"
## [13] "local_global" "maker"
## [15] "measures_climate" "measures_college"
## [17] "measures_purpose" "oer"
## [19] "other_leaders" "poverty_supports"
## [21] "quality_materials" "relevant_learning"
## [23] "rigorous_coursework" "sel_plan"
## [25] "staffing_infrastructure" "wraparound"
These are the rest.
Let’s look more closely at the top 10 on this list.
top_core <- core_prac_dat %>%
head(10) %>%
pull(core_practice)
top_core_dat <- core_prac %>%
filter(core_practice %in% top_core) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected))top_core_dat %>%
filter(year != 2019) %>%
ggplot(aes(reorder(core_practice, selected), selected, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) It looks like 2021 was really driving the top core practices list across the years. Is that true?
tags_2019 <- full_tags_long %>%
filter(year == 2019) %>%
group_by(var) %>%
summarise(`2019` = sum(usage), .groups = "drop") #173 schools
tags_2021 <- full_tags_long %>%
filter(year == 2021) %>%
group_by(var) %>%
summarise(`2021` = sum(usage), .groups = "drop") #232 schools
tags_2022 <- full_tags_long %>%
filter(year == 2022) %>%
group_by(var) %>%
summarise(`2022` = sum(usage), .groups = "drop") #161 schools
tags_2023 <- full_tags_long %>%
filter(year == 2023) %>%
group_by(var) %>%
summarise(`2023` = sum(usage), .groups = "drop") #251 schools
tags_2024 <- full_tags_long %>%
filter(year == 2024) %>%
group_by(var) %>%
summarise(`2024` = sum(usage), .groups = "drop") #189 schools# Create a dataframe with variables and their years
tags_list <- list(
`2019` = tags_2019 %>% pull(var) %>% unique(),
`2021` = tags_2021 %>% pull(var) %>% unique(),
`2022` = tags_2022 %>% pull(var) %>% unique(),
`2023` = tags_2023 %>% pull(var) %>% unique(),
`2024` = tags_2024 %>% pull(var) %>% unique()
)
# Combine the list into a long dataframe
tags_df <- bind_rows(
lapply(names(tags_list), function(year) {
data.frame(variable = tags_list[[year]], year = as.integer(year))
})
)
# Summarize the number of years each variable is used and list the years used
variable_usage <- tags_df %>%
group_by(variable) %>%
summarise(
number_of_years_used = n_distinct(year),
years_used = paste(sort(unique(year)), collapse = ", ")
)Now, let’s look more closely at the tags that have never been selected as core.
variable_usage %>%
mutate(variable = sub("practices_", "", variable)) %>%
filter(variable %in% no_core) %>%
datatable()Looks like all are from 2019 except other_leaders, which
is from 2023.
Here is the rest of them.
I want to look at the top 10 core practices by year implemented stacked bar chart by also looking at the years the tag was offered.
top_core_dat <- top_core_dat %>%
mutate(core_practice = gsub("core_", "", core_practice))
top_by_use <- variable_usage %>%
mutate(variable = gsub("practices_", "", variable)) %>%
right_join(., top_core_dat, by = c("variable" = "core_practice"))
total_select <- top_by_use %>%
group_by(variable) %>%
summarise(total_select = sum(selected)) %>%
ungroup()
top_by_use <- left_join(top_by_use, total_select)tag_labels <- import(here("data/longitudinal", "tag-labels.csv"))
top_by_use %>%
filter(year != 2019) %>%
left_join(., tag_labels) %>%
ggplot() +
geom_text(aes(label = years_used, x = label, y = total_select + 2), hjust = 0, size = 3, color = "gray") +
geom_col(aes(reorder(label, selected), selected, fill = year)) +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), limits = c(0, 340)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 8.5),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) Well, this is an interesting question given that 2021 seems like it was the year that schools were more liberal with their core practice selections, so I imagine this affects most practices. But let’s look at them below.
p <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
mutate(year = as.numeric(year)) %>%
ggplot(aes(year, selected, color = core_practice)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("core_practice", "selected"))clean_labels <- import(here("data/longitudinal", "tag-labels.csv"))
variable_usage_by_year <- tags_2019 %>%
full_join(tags_2021, by = "var") %>%
full_join(tags_2022, by = "var") %>%
full_join(tags_2023, by = "var") %>%
full_join(tags_2024, by = "var") %>%
left_join(clean_labels, by = c("var" = "variable"))variable_usage_by_year %>%
select(label, everything(), -var) %>%
mutate(total = rowSums(select(.,`2019`:`2024`), na.rm = TRUE)) %>%
datatable()Filter to tags that have been used at least 4 years.
Are we seeing a lot of “brand new” practices piloted, are schools more or less trying out “established” practices, or both?
load(here("data/2024 data", "complete_canopy_2024.RData"))
old_clusters <- import(here("data/clusters_through_2024.csv"))pilot_prac <- tags %>%
select(starts_with("pilot")) %>%
pivot_longer(everything(),
names_to = "practice",
values_to = "N",
names_prefix = "pilot_") %>%
group_by(practice) %>%
summarise(selected = sum(N))These are the practices by time implemented:
implementation_time <- tags %>%
select(starts_with("time_")) %>%
pivot_longer(everything(),
names_to = "practice",
values_to = "N") %>%
mutate(`Not sure` = case_when(N == "Not sure" ~ 1,
TRUE ~ 0),
`Less than a year` = case_when(N == "Less than a year" ~ 1,
TRUE ~ 0),
`1-2 years` = case_when(N == "1-2 years" ~ 1,
TRUE ~ 0),
`3-4 years` = case_when(N == "3-4 years" ~ 1,
TRUE ~ 0),
`5+ years` = case_when(N == "5+ years" ~ 1,
TRUE ~ 0),
practice = sub("time_", "", practice)) %>%
select(!N) %>%
group_by(practice) %>%
summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE)))
# Plot dat setup
implementation_time_plot <- implementation_time %>%
pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
names_to = "time",
values_to = "N") %>%
mutate(time = factor(time, levels = c(
"Less than a year",
"1-2 years",
"3-4 years",
"5+ years"
)))
# Practice axes setup
cluster_colors <- unique(old_clusters$cluster) %>%
setNames(object = c(transcend_cols2[c(1, 2, 4, 5)], "#000000"))
clusters <- old_clusters %>%
mutate(practice = sub("practices_", "", var)) %>%
select(-var)
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>%
mutate(
color = cluster_colors[cluster],
practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
)
# Plot (referenced Gregor's code)
ggplot(implementation_with_color, aes(reorder(practice, N), N, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
labs(title = "Core Practices by Time Implemented",
x = "",
y = "") +
scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)Now let’s sort by pilot practice selection (descending).
# Plot dat setup
implementation_time_plot <- time_pilot %>%
pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
names_to = "time",
values_to = "N") %>%
mutate(time = factor(time, levels = c(
"Less than a year",
"1-2 years",
"3-4 years",
"5+ years"
)))
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>%
mutate(
color = cluster_colors[cluster],
practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
)
ggplot(implementation_with_color, aes(reorder(practice, selected), N, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
labs(title = "Core Practices by Time Implemented, From Most to Least Selected to Pilot",
x = "",
y = "") +
scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)## # A tibble: 20 × 3
## # Groups: cluster [5]
## cluster time total
## <chr> <fct> <dbl>
## 1 Deeper learning Less than a year 7
## 2 Deeper learning 1-2 years 28
## 3 Deeper learning 3-4 years 50
## 4 Deeper learning 5+ years 199
## 5 Ed justice Less than a year 6
## 6 Ed justice 1-2 years 40
## 7 Ed justice 3-4 years 48
## 8 Ed justice 5+ years 161
## 9 Individualized Less than a year 2
## 10 Individualized 1-2 years 9
## 11 Individualized 3-4 years 19
## 12 Individualized 5+ years 59
## 13 None Less than a year 6
## 14 None 1-2 years 21
## 15 None 3-4 years 49
## 16 None 5+ years 111
## 17 Postsecondary Less than a year 2
## 18 Postsecondary 1-2 years 17
## 19 Postsecondary 3-4 years 18
## 20 Postsecondary 5+ years 76
Note, cluster counts are different. What is the best way to represent these cluster selections by time given these differences?
## # A tibble: 5 × 2
## cluster count
## <chr> <int>
## 1 Deeper learning 12
## 2 Ed justice 19
## 3 Individualized 9
## 4 None 24
## 5 Postsecondary 9
core_prac %>%
filter(times_selected >0) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
left_join(., old_clusters, by = c("core_practice" = "var")) %>%
group_by(cluster, year) %>%
summarise(n = n()) %>%
filter(!is.na(cluster)) %>%
ggplot(aes(fill = cluster)) +
geom_col(aes(year, n)) +
facet_grid(~cluster) +
scale_y_continuous(expand = c(0,0)) +
theme(panel.grid.major.x = element_blank(),
legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1, size = 7)) +
scale_fill_manual(values = transcend_cols2) +
labs(title = "Cluster Selection by Year",
x = "",
y = "")implementation_with_color %>%
group_by(cluster, time) %>%
summarise(total = sum(N)) %>%
ggplot(aes(reorder(cluster, total), total, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Practice Clusters by Time Implemented",
x = "",
y = "") +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)